home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / dinit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-21  |  15.1 KB  |  486 lines
  1. /* dinit.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  33.         sfactr;
  34.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  35.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  36. } status_;
  37.  
  38. #define status_1 status_
  39.  
  40. struct {
  41.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  42.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  43. } flags_;
  44.  
  45. #define flags_1 flags_
  46.  
  47. struct {
  48.     doublereal value[200000];
  49. } blank_;
  50.  
  51. #define blank_1 blank_
  52.  
  53. /*<       subroutine dinit >*/
  54. /* Subroutine */ int dinit_()
  55. {
  56.     /* System generated locals */
  57.     integer i_1;
  58.  
  59.     /* Builtin functions */
  60.     double exp(), log();
  61.  
  62.     /* Local variables */
  63.     static doublereal cdbo, area, fcpb, fcpc, fcpe, cjco, evbc, cjeo;
  64.     static integer locd;
  65.     static doublereal czbc, czbe, evbe, cbor, gmo23;
  66.     static integer locm;
  67.     static doublereal csat, sarg, gm2o3;
  68.     static integer locv, loct;
  69.     static doublereal phib, cdjo, argd;
  70.     extern /* Subroutine */ int getm8_();
  71.     static doublereal argbc, argbe, denom;
  72.     extern /* Subroutine */ int getm16_();
  73.     static doublereal czero, trivt, twovt, pc, gm, pe, go, tf, vd, xm, tr;
  74. #define nodplc ((integer *)&blank_1)
  75. #define cvalue ((complex *)&blank_1)
  76.     static doublereal cbe, cbc, go2, gm2, cb1, go3, gm3, cb2, twovte, trivte, 
  77.         cbo, arg, vbc;
  78.     static integer loc;
  79.     static doublereal vbe, gpi, geq, evd, ova, xmc, gmu, xme, tau, vte, cdb1, 
  80.         cdb2, cjc1, cjc2, cje1, cje2, cdj1, cdj2, cb1r, cb2r, geq2, geq3, 
  81.         gpi2, gpi3, gmo2, gmu2, gmu3;
  82.  
  83. /*<       implicit double precision (a-h,o-z) >*/
  84.  
  85. /*     this routine performs storage-allocation and one-time computation 
  86. */
  87. /* needed to do the small-signal distortion analysis. */
  88.  
  89. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  90. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  91. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  92. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  93. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  94. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  95. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  96. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  97. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  98. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  99. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  100. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  101. /* spice version 2g.6  sccsid=status 3/15/83 */
  102. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  103. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  104. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  105. /* spice version 2g.6  sccsid=flags 3/15/83 */
  106. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  107. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  108. /* spice version 2g.6  sccsid=blank 3/15/83 */
  109. /*<       common /blank/ value(200000) >*/
  110. /*<       integer nodplc(64) >*/
  111. /*<       complex cvalue(32) >*/
  112. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  113.  
  114.  
  115. /*<       call getm8(ld0,ndist) >*/
  116.     getm8_(&tabinf_1.ld0, &cirdat_1.ndist);
  117. /*<       call getm16(ld1,5*nstop) >*/
  118.     i_1 = cirdat_1.nstop * 5;
  119.     getm16_(&tabinf_1.ld1, &i_1);
  120.  
  121. /*  bipolar junction transistors */
  122.  
  123. /*<       loc=locate(12) >*/
  124.     loc = cirdat_1.locate[11];
  125. /*<   100 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 200 >*/
  126. L100:
  127.     if (loc == 0 || nodplc[loc + 35] != 0) {
  128.     goto L200;
  129.     }
  130. /*<       locv=nodplc(loc+1) >*/
  131.     locv = nodplc[loc];
  132. /*<       area=value(locv+1) >*/
  133.     area = blank_1.value[locv];
  134. /*<       locm=nodplc(loc+8) >*/
  135.     locm = nodplc[loc + 7];
  136. /*<       locm=nodplc(locm+1) >*/
  137.     locm = nodplc[locm];
  138. /*<       loct=lx0+nodplc(loc+22) >*/
  139.     loct = tabinf_1.lx0 + nodplc[loc + 21];
  140. /*<       locd=ld0+nodplc(loc+23) >*/
  141.     locd = tabinf_1.ld0 + nodplc[loc + 22];
  142. /*<       csat=value(locm+1)*area >*/
  143.     csat = blank_1.value[locm] * area;
  144. /*<       ova=value(locm+4) >*/
  145.     ova = blank_1.value[locm + 3];
  146. /*<       tf=value(locm+24) >*/
  147.     tf = blank_1.value[locm + 23];
  148. /*<       tr=value(locm+33) >*/
  149.     tr = blank_1.value[locm + 32];
  150. /*<       czbe=value(locm+21)*area >*/
  151.     czbe = blank_1.value[locm + 20] * area;
  152. /*<       czbc=value(locm+29)*area >*/
  153.     czbc = blank_1.value[locm + 28] * area;
  154. /*<       pe=value(locm+22) >*/
  155.     pe = blank_1.value[locm + 21];
  156. /*<       xme=value(locm+23) >*/
  157.     xme = blank_1.value[locm + 22];
  158. /*<       pc=value(locm+30) >*/
  159.     pc = blank_1.value[locm + 29];
  160. /*<       xmc=value(locm+31) >*/
  161.     xmc = blank_1.value[locm + 30];
  162. /*<       fcpe=value(locm+46) >*/
  163.     fcpe = blank_1.value[locm + 45];
  164. /*<       fcpc=value(locm+50) >*/
  165.     fcpc = blank_1.value[locm + 49];
  166. /*<       vbe=value(loct) >*/
  167.     vbe = blank_1.value[loct - 1];
  168. /*<       vbc=value(loct+1) >*/
  169.     vbc = blank_1.value[loct];
  170. /*<       gpi=value(loct+4) >*/
  171.     gpi = blank_1.value[loct + 3];
  172. /*<       go=value(loct+7) >*/
  173.     go = blank_1.value[loct + 6];
  174. /*<       gm=value(loct+6) >*/
  175.     gm = blank_1.value[loct + 5];
  176. /*<       gmu=value(loct+5) >*/
  177.     gmu = blank_1.value[loct + 4];
  178. /*<       if (vbe.gt.0.0d0) go to 110 >*/
  179.     if (vbe > 0.) {
  180.     goto L110;
  181.     }
  182. /*<       evbe=1.0d0 >*/
  183.     evbe = 1.;
  184. /*<       cbe=csat*vbe/vt >*/
  185.     cbe = csat * vbe / status_1.vt;
  186. /*<       go to 120 >*/
  187.     goto L120;
  188. /*<   110 evbe=dexp(vbe/vt) >*/
  189. L110:
  190.     evbe = exp(vbe / status_1.vt);
  191. /*<       cbe=csat*(evbe-1.0d0) >*/
  192.     cbe = csat * (evbe - 1.);
  193. /*<   120 if (vbc.gt.0.0d0) go to 130 >*/
  194. L120:
  195.     if (vbc > 0.) {
  196.     goto L130;
  197.     }
  198. /*<       evbc=1.0d0 >*/
  199.     evbc = 1.;
  200. /*<       cbc=csat*vbc/vt >*/
  201.     cbc = csat * vbc / status_1.vt;
  202. /*<       arg=1.0d0-vbc/pc >*/
  203.     arg = 1. - vbc / pc;
  204. /*<       go to 140 >*/
  205.     goto L140;
  206. /*<   130 evbc=dexp(vbc/vt) >*/
  207. L130:
  208.     evbc = exp(vbc / status_1.vt);
  209. /*<       cbc=csat*(evbc-1.0d0) >*/
  210.     cbc = csat * (evbc - 1.);
  211. /*<   140 if (vbe.ge.fcpe) go to 150 >*/
  212. L140:
  213.     if (vbe >= fcpe) {
  214.     goto L150;
  215.     }
  216. /*<       arg=1.0d0-vbe/pe >*/
  217.     arg = 1. - vbe / pe;
  218. /*<       sarg=dexp(xme*dlog(arg)) >*/
  219.     sarg = exp(xme * log(arg));
  220. /*<       cjeo=czbe/sarg >*/
  221.     cjeo = czbe / sarg;
  222. /*<       argbe=pe-vbe >*/
  223.     argbe = pe - vbe;
  224. /*<       cje1=xme*cjeo/argbe >*/
  225.     cje1 = xme * cjeo / argbe;
  226. /*<       cje2=(1.0d0+xme)*cje1/argbe >*/
  227.     cje2 = (xme + 1.) * cje1 / argbe;
  228. /*<       go to 160 >*/
  229.     goto L160;
  230. /*<   150 denom=dexp((1.0d0+xme)*dlog(1.0d0-fcpe)) >*/
  231. L150:
  232.     denom = exp((xme + 1.) * log(1. - fcpe));
  233. /*<       cjeo=czbe*(1.0d0-fcpe*(1.0d0+xme)+xme*vbe/pe)/denom >*/
  234.     cjeo = czbe * (1. - fcpe * (xme + 1.) + xme * vbe / pe) / denom;
  235. /*<       cje1=czbe*xme/(denom*pe) >*/
  236.     cje1 = czbe * xme / (denom * pe);
  237. /*<       cje2=0.0d0 >*/
  238.     cje2 = 0.;
  239. /*<   160 if (vbc.ge.fcpc) go to 170 >*/
  240. L160:
  241.     if (vbc >= fcpc) {
  242.     goto L170;
  243.     }
  244. /*<       arg=1.0d0-vbc/pc >*/
  245.     arg = 1. - vbc / pc;
  246. /*<       sarg=dexp(xmc*dlog(arg)) >*/
  247.     sarg = exp(xmc * log(arg));
  248. /*<       cjco=czbc/sarg >*/
  249.     cjco = czbc / sarg;
  250. /*<       argbc=pc-vbc >*/
  251.     argbc = pc - vbc;
  252. /*<       cjc1=xmc*cjco/argbc >*/
  253.     cjc1 = xmc * cjco / argbc;
  254. /*<       cjc2=(1.0d0+xmc)*cjc1/argbc >*/
  255.     cjc2 = (xmc + 1.) * cjc1 / argbc;
  256. /*<       go to 180 >*/
  257.     goto L180;
  258. /*<   170 denom=dexp((1.0d0+xmc)*dlog(1.0d0-fcpc)) >*/
  259. L170:
  260.     denom = exp((xmc + 1.) * log(1. - fcpc));
  261. /*<       cjco=czbc*(1.0d0-fcpc*(1.0d0+xmc)+xmc*vbc/pc)/denom >*/
  262.     cjco = czbc * (1. - fcpc * (xmc + 1.) + xmc * vbc / pc) / denom;
  263. /*<       cjc1=czbc*xmc/(denom*pc) >*/
  264.     cjc1 = czbc * xmc / (denom * pc);
  265. /*<       cjc2=0.0d0 >*/
  266.     cjc2 = 0.;
  267. /*<   180 twovt=vt+vt >*/
  268. L180:
  269.     twovt = status_1.vt + status_1.vt;
  270. /*<       go2=(-go+csat*(evbe+evbc)*ova)/twovt >*/
  271.     go2 = (-go + csat * (evbe + evbc) * ova) / twovt;
  272. /*<       gmo2=(cbe+csat)*ova/vt-2.0d0*go2 >*/
  273.     gmo2 = (cbe + csat) * ova / status_1.vt - go2 * 2.;
  274. /*<       gm2=(gm+go)/twovt-gmo2-go2 >*/
  275.     gm2 = (gm + go) / twovt - gmo2 - go2;
  276. /*<       gmu2=gmu/twovt >*/
  277.     gmu2 = gmu / twovt;
  278. /*<       if (vbc.le.0.0d0) gmu2=0.0d0 >*/
  279.     if (vbc <= 0.) {
  280.     gmu2 = 0.;
  281.     }
  282. /*<       gpi2=gpi/twovt >*/
  283.     gpi2 = gpi / twovt;
  284. /*<       if (vbe.le.0.0d0) gpi2=0.0d0 >*/
  285.     if (vbe <= 0.) {
  286.     gpi2 = 0.;
  287.     }
  288. /*<       cbo=tf*csat*evbe/vt >*/
  289.     cbo = tf * csat * evbe / status_1.vt;
  290. /*<       cbor=tr*csat*evbc/vt >*/
  291.     cbor = tr * csat * evbc / status_1.vt;
  292. /*<       cb1=cbo/vt >*/
  293.     cb1 = cbo / status_1.vt;
  294. /*<       cb1r=cbor/vt >*/
  295.     cb1r = cbor / status_1.vt;
  296. /*<       trivt=3.0d0*vt >*/
  297.     trivt = status_1.vt * 3.;
  298. /*<       go3=-(go2+(cbc+csat)*ova/twovt)/trivt >*/
  299.     go3 = -(go2 + (cbc + csat) * ova / twovt) / trivt;
  300. /*<       gmo23=-3.0d0*go3 >*/
  301.     gmo23 = go3 * -3.;
  302. /*<       gm2o3=-gmo23+(cbe+csat)*ova/(vt*twovt) >*/
  303.     gm2o3 = -gmo23 + (cbe + csat) * ova / (status_1.vt * twovt);
  304. /*<       gm3=(gm2-(cbe-cbc)*ova/twovt)/trivt >*/
  305.     gm3 = (gm2 - (cbe - cbc) * ova / twovt) / trivt;
  306. /*<       gmu3=gmu2/trivt >*/
  307.     gmu3 = gmu2 / trivt;
  308. /*<       gpi3=gpi2/trivt >*/
  309.     gpi3 = gpi2 / trivt;
  310. /*<       cb2=cb1/twovt >*/
  311.     cb2 = cb1 / twovt;
  312. /*<       cb2r=cb1r/twovt >*/
  313.     cb2r = cb1r / twovt;
  314. /*<       value(locd)=cje1 >*/
  315.     blank_1.value[locd - 1] = cje1;
  316. /*<       value(locd+1)=cje2 >*/
  317.     blank_1.value[locd] = cje2;
  318. /*<       value(locd+2)=cjc1 >*/
  319.     blank_1.value[locd + 1] = cjc1;
  320. /*<       value(locd+3)=cjc2 >*/
  321.     blank_1.value[locd + 2] = cjc2;
  322. /*<       value(locd+4)=go2 >*/
  323.     blank_1.value[locd + 3] = go2;
  324. /*<       value(locd+5)=gmo2 >*/
  325.     blank_1.value[locd + 4] = gmo2;
  326. /*<       value(locd+6)=gm2 >*/
  327.     blank_1.value[locd + 5] = gm2;
  328. /*<       value(locd+7)=gmu2 >*/
  329.     blank_1.value[locd + 6] = gmu2;
  330. /*<       value(locd+8)=gpi2 >*/
  331.     blank_1.value[locd + 7] = gpi2;
  332. /*<       value(locd+9)=cbo >*/
  333.     blank_1.value[locd + 8] = cbo;
  334. /*<       value(locd+10)=cbor >*/
  335.     blank_1.value[locd + 9] = cbor;
  336. /*<       value(locd+11)=cb1 >*/
  337.     blank_1.value[locd + 10] = cb1;
  338. /*<       value(locd+12)=cb1r >*/
  339.     blank_1.value[locd + 11] = cb1r;
  340. /*<       value(locd+13)=go3 >*/
  341.     blank_1.value[locd + 12] = go3;
  342. /*<       value(locd+14)=gmo23 >*/
  343.     blank_1.value[locd + 13] = gmo23;
  344. /*<       value(locd+15)=gm2o3 >*/
  345.     blank_1.value[locd + 14] = gm2o3;
  346. /*<       value(locd+16)=gm3 >*/
  347.     blank_1.value[locd + 15] = gm3;
  348. /*<       value(locd+17)=gmu3 >*/
  349.     blank_1.value[locd + 16] = gmu3;
  350. /*<       value(locd+18)=gpi3 >*/
  351.     blank_1.value[locd + 17] = gpi3;
  352. /*<       value(locd+19)=cb2 >*/
  353.     blank_1.value[locd + 18] = cb2;
  354. /*<       value(locd+20)=cb2r >*/
  355.     blank_1.value[locd + 19] = cb2r;
  356. /*<       loc=nodplc(loc) >*/
  357.     loc = nodplc[loc - 1];
  358. /*<       go to 100 >*/
  359.     goto L100;
  360.  
  361. /*  diodes */
  362.  
  363. /*<   200 loc=locate(11) >*/
  364. L200:
  365.     loc = cirdat_1.locate[10];
  366. /*<   210 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 300 >*/
  367. L210:
  368.     if (loc == 0 || nodplc[loc + 15] != 0) {
  369.     goto L300;
  370.     }
  371. /*<       locv=nodplc(loc+1) >*/
  372.     locv = nodplc[loc];
  373. /*<       area=value(locv+1) >*/
  374.     area = blank_1.value[locv];
  375. /*<       locm=nodplc(loc+5) >*/
  376.     locm = nodplc[loc + 4];
  377. /*<       locm=nodplc(locm+1) >*/
  378.     locm = nodplc[locm];
  379. /*<       loct=lx0+nodplc(loc+11) >*/
  380.     loct = tabinf_1.lx0 + nodplc[loc + 10];
  381. /*<       locd=ld0+nodplc(loc+12) >*/
  382.     locd = tabinf_1.ld0 + nodplc[loc + 11];
  383. /*<       csat=value(locm+1)*area >*/
  384.     csat = blank_1.value[locm] * area;
  385. /*<       vte=value(locm+3)*vt >*/
  386.     vte = blank_1.value[locm + 2] * status_1.vt;
  387. /*<       tau=value(locm+4) >*/
  388.     tau = blank_1.value[locm + 3];
  389. /*<       czero=value(locm+5)*area >*/
  390.     czero = blank_1.value[locm + 4] * area;
  391. /*<       phib=value(locm+6) >*/
  392.     phib = blank_1.value[locm + 5];
  393. /*<       xm=value(locm+7) >*/
  394.     xm = blank_1.value[locm + 6];
  395. /*<       fcpb=value(locm+12) >*/
  396.     fcpb = blank_1.value[locm + 11];
  397. /*<       vd=value(loct) >*/
  398.     vd = blank_1.value[loct - 1];
  399. /*<       geq=value(loct+2) >*/
  400.     geq = blank_1.value[loct + 1];
  401. /*<       evd=1.0d0 >*/
  402.     evd = 1.;
  403. /*<       if (vd.ge.0.0d0) evd=dexp(vd/vte) >*/
  404.     if (vd >= 0.) {
  405.     evd = exp(vd / vte);
  406.     }
  407. /*<       if (vd.ge.fcpb) go to 220 >*/
  408.     if (vd >= fcpb) {
  409.     goto L220;
  410.     }
  411. /*<       arg=1.0d0-vd/phib >*/
  412.     arg = 1. - vd / phib;
  413. /*<       sarg=dexp(xm*dlog(arg)) >*/
  414.     sarg = exp(xm * log(arg));
  415. /*<       cdjo=czero/sarg >*/
  416.     cdjo = czero / sarg;
  417. /*<       argd=phib-vd >*/
  418.     argd = phib - vd;
  419. /*<       cdj1=xm*cdjo/argd >*/
  420.     cdj1 = xm * cdjo / argd;
  421. /*<       cdj2=(1.0d0+xm)*cdj1/argd >*/
  422.     cdj2 = (xm + 1.) * cdj1 / argd;
  423. /*<       go to 230 >*/
  424.     goto L230;
  425. /*<   220 denom=dexp((1.0d0+xm)*dlog(1.0d0-fcpb)) >*/
  426. L220:
  427.     denom = exp((xm + 1.) * log(1. - fcpb));
  428. /*<       cdjo=czero*(1.0d0-fcpb*(1.0d0+xm)+xm*vd/phib)/denom >*/
  429.     cdjo = czero * (1. - fcpb * (xm + 1.) + xm * vd / phib) / denom;
  430. /*<       cdj1=czero*xm/(denom*phib) >*/
  431.     cdj1 = czero * xm / (denom * phib);
  432. /*<       cdj2=0.0d0 >*/
  433.     cdj2 = 0.;
  434. /*<       cdj2=0.0d0 >*/
  435.     cdj2 = 0.;
  436. /*<   230 cdbo=tau*csat*evd/vte >*/
  437. L230:
  438.     cdbo = tau * csat * evd / vte;
  439. /*<       cdb1=cdbo/vte >*/
  440.     cdb1 = cdbo / vte;
  441. /*<       twovte=2.0d0*vte >*/
  442.     twovte = vte * 2.;
  443. /*<       geq2=geq/twovte >*/
  444.     geq2 = geq / twovte;
  445. /*<       if (vd.le.0.0d0) geq2=0.0d0 >*/
  446.     if (vd <= 0.) {
  447.     geq2 = 0.;
  448.     }
  449. /*<       trivte=3.0d0*vte >*/
  450.     trivte = vte * 3.;
  451. /*<       geq3=geq2/trivte >*/
  452.     geq3 = geq2 / trivte;
  453. /*<       cdb2=cdb1/twovte >*/
  454.     cdb2 = cdb1 / twovte;
  455. /*<       value(locd)=cdj1 >*/
  456.     blank_1.value[locd - 1] = cdj1;
  457. /*<       value(locd+1)=cdj2 >*/
  458.     blank_1.value[locd] = cdj2;
  459. /*<       value(locd+2)=cdbo >*/
  460.     blank_1.value[locd + 1] = cdbo;
  461. /*<       value(locd+3)=cdb1 >*/
  462.     blank_1.value[locd + 2] = cdb1;
  463. /*<       value(locd+4)=geq2 >*/
  464.     blank_1.value[locd + 3] = geq2;
  465. /*<       value(locd+5)=geq3 >*/
  466.     blank_1.value[locd + 4] = geq3;
  467. /*<       value(locd+6)=cdb2 >*/
  468.     blank_1.value[locd + 5] = cdb2;
  469. /*<       loc=nodplc(loc) >*/
  470.     loc = nodplc[loc - 1];
  471. /*<       go to 210 >*/
  472.     goto L210;
  473.  
  474. /*  finished */
  475.  
  476. /*<   300 return >*/
  477. L300:
  478.     return 0;
  479. /*<       end >*/
  480. } /* dinit_ */
  481.  
  482. #undef cvalue
  483. #undef nodplc
  484.  
  485.  
  486.